Celestin Apprentice 4

home *** CD-ROM | disk | FTP | other *** search

/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Toolbox classes / List manager < prev next >

Wrap

Text File | 1994-05-08 | 14.3 KB | 554 lines | [TEXT/MSET]

\ List manager class - thanks to Greg Haverkamp for this. \ Note that Greg wrote this for Mops 2.3, before controls became views. \ Therefore some things could probably be simplified a bit under 2.4. \ I've checked it compiles, but that's all. -- Mike. \ Here's Greg's .sig: \ Greg Haverkamp -- gh1w@andrew.cmu.edu, dietcoke+@cmu.edu \ Industrial Management - '94 \ Carnegie Mellon University, Pittsburgh, Pennsylvania \ \ "Sometimes I think life is just a rodeo. The trick is to ride and make \ it to the bell." John Fogerty, "Rock and Roll Girls" \ The following classes provide support for the Mac Toolbox List \ Manager package. Unfortunately, some of this support is less than \ elegant, so please be sure to read the accompanying explanatory \ info before using the routines. \ Greg Haverkamp need window+ string tempString \ Class MyPtrList \ \ Okay, this is almost entirely a ripoff of Class PtrList from View. All I \ did was add a remove: method so that when a list is killed, we can rid \ ourselves of it. :CLASS MyPtrList super{ string+ sequence } \ With lots stolen from PtrList :m Add: \ ( ptr -- ) pad ! pad 4 add: super ;m :m First?: size: super nif false exit then \ No elements - return false reset: super ^1st: super @ true ;m :m Next?: \ ( -- ptr T | -- F ) 4 skip: super len: super NIF false exit THEN ^1st: super @ true ;m :m Remove: ( ptr -- b ) \ Returns true if found, false if not. pad ! pad 4 search: self if step: self 4 deleteN: self true else false then ;m :m Length?: ( -- n ) size: super ;m ;CLASS \ Class ListWindow \ \ This class provides support for lists, especially for controlling the \ actions of List Manager-created scroll bars. \ Greg Haverkamp :CLASS ListWindow super{ window+ } \ Content: This method is necessary for a number of reasons. However, \ in talking to Mike, its necessity might change. If you look at the \ content: method in Window+, then you'll notice that the first \ thing it does is to check to see if a control was hit, and if it was, \ it tries to find the control's handler. This did not sit well with \ the List Manager, as it like to control its own scroll bar. \ Therefore, this content: checks through the ptrlist of Lists to \ to see if they should handle it. :m CONTENT: \ Handles a content click, checking for lists first. active: self \ Find out if this window is active IF get: ^contView ListCheck: ** \ Check any lists in the contView NIF noClip get: ^contView click: ** drop \ Or just a click in a view THEN ELSE select: self THEN ;m ;CLASS \ Class List \ \ This class provides for the basic structure and needs of a list. \ Greg Haverkamp 6 August 93 \ \ Note that I attempted, when possible, to use the Mops naming scheme for \ everything. However, that was not always practical, so many things are \ named for their toolbox calls. \ \ Here is the process for creating a list and a listView: \ 1) Create a contView of class ListView \ ListView MyContView \ 2) Create any objects of class ListView \ ListView MyListView \ 3) Create any other views you might have \ view MyRegularView \ 4) Create the list you want \ List MyList \ 5) Add all of the sub-views to the contView \ MyListView addListView: MyContView \ MyRegularView addView: MyContView \ (NOTE: You use addListView: for sub-views of type ListView, but continue \ to use the method addView: for regular views. The class ListView will \ handle the differentiation.) \ 6) Set up all of the parameters as described for NewList: \ 7) Execute ^theView NewList: \ 8) Add the lists to the appropriate view \ MyList addList: MyListView \ 9) Serve hot and enjoy. :) :CLASS List super{ object } record { handle ListHandle handle ListRegion \ Needed for updating ptr ListPointer rect rView rect dataBounds point cSize int theProc ptr WindowPtr bool drawIt bool hasGrow bool scrollHoriz bool scrollVert bool List? ptr MyView } \ My flag hacks. Sorry about the pain in the butt these cause. \ List: should be set true as soon as a list is successfully started. \ List?: can be used to see if there is a list present. This might \ seem odd, but it became necessary in the list checking for the \ writing of ListWindow's Content: method. \ \ Well, these are not such a pain now, as the list creation methods now \ take care of setting them. GAH 6 Aug 93 :m List: ( bool -- ) \ put true in here after you have called NewList: put: List? \ for the pertinent list. ;m :m List?: ( -- bool ) \ I dunno if you'll ever need to use this, but get: List? \ this can be used to check to make sure a list ;m \ exists prior to calling List Manager routines. \ If you don't, you can get some very nasty \ results. (I don't much care for the way \ MacsBug fills up my screen.) \ We use explicit names here to make it very clear which portions \ of the list parameters we are modifying. As I say later, I also \ prefer this to having a HUGE list of unnamed parameters. :m PutrView: ( l t r b -- ) put: rView ;m :m PutDataBounds: ( l t r b -- ) put: dataBounds ;m :m PutcSize: ( x y -- ) \ 0 0 will force auto-calc by toolbox put: cSize ;m :m PuttheProc: ( n -- ) \ 0 for default List Manager LDEF put: theProc ;m :m PutWindowPtr: ( ptr -- ) put: WindowPtr ;m :m PutdrawIt: ( bool -- ) \ Drawing on? put: drawIt ;m :m PutHasGrow: ( bool -- ) \ Does the window have a grow box? put: hasGrow ;m :m PutScrollHoriz: ( bool -- ) \ Do we want a horiz scrollbar? put: ScrollHoriz ;m :m PutScrollVert: ( bool -- ) \ Do we want a vert scrollbar? put: ScrollVert ;m :m PutRegion: ( rgnHandle -- ) put: ListRegion ;m \ I'm not sure why I put this in here... but we'll leave it should \ we ever decide we need it. :m Handle: ( -- handle ) get: ListHandle ;m \ Creating and Disposing of Lists :m New: { ^View -- } \ Call this to create a new list, but \ Be sure that you first make sure you have \ set up all the parameters. \ I just prefer doing it this way so that all of the \ items are well known, and the placement order \ doesn't matter. 0 \ Leave room for return handle addr: rView addr: dataBounds int: cSize int: theProc get: WindowPtr get: drawIt tbool get: hasGrow tbool get: scrollHoriz tbool get: scrollVert tbool call lNew put: ListHandle true List: self ^View put: MyView ;m :m Dispose: ( -- ) \ Call this when you're done to clean \ things up. (these lists can really \ suck memory when they get big.) get: ListHandle call lDispose false List: self ^base get: myView removeList: ** ;m \ Adding and Deleting Rows and Columns :m AddColumn: { count colNum -- } \ this returns the col # added 0 \ make room count colNum pack get: ListHandle call lAddColumn ;m :m AddRow: { count rowNum -- } \ this returns to row # added 0 \ make room count rowNum pack get: ListHandle call lAddRow ;m :m DeleteColumn: ( count colNum -- ) \ See ya buddy. get: ListHandle call lDelColumn ;m :m DeleteRow: ( count rowNum -- ) \ And your friend, too. get: ListHandle call lDelRow ;m \ Operations on Cells :m Add: { addr len theCell -- } \ This will add information to \ what is currently contained \ in the cell. addr len makeint theCell get: ListHandle call lAddToCell ;m :m Clear: ( theCell -- ) \ This, of course, clears the cell. get: ListHandle call lClrCell ;m :m Get: ( addr ^len theCell -- ) \ This will give you the string \ from a cell. get: ListHandle call lGetCell ;m :m put: { addr len theCell -- } \ Use this to store info into a \ cell. Note that this will \ overwrite anything that was \ already there. addr len makeint theCell get: ListHandle call lSetCell ;m :m CellSize: ( cSize -- ) get: ListHandle call lCellSize ;m :m Selected?: { next ^theCell -- } word0 \ make room for return next ^theCell get: ListHandle call lGetSelect ;m :m Deselect: { theCell -- } false tbool theCell get: ListHandle call lSetSelect ;m :m Select: { theCell -- } true tbool theCell get: ListHandle call lSetSelect ;m \ Mouse Location :m Click: { pt modifiers -- b } \ Handles a click in the list's view. \ Returns true if double click. word0 \ make room pt modifiers makeint get: ListHandle call lClick ;m :m WhichCell?: ( -- theCell ) \ Which was the last cell clicked in? \ The key here is that this was actually \ just the last cell that was clicked \ in... no necessarily the selected cell. \ Primarily, though, it will probably \ be the same thing. 0 \ make room get: ListHandle call lLastClick ;m \ Accessing Cells \ These are all untested. I can't verify that they work. :m Find: ( ^offset ^ length theCell -- ) get: listHandle call lFind ;m :m NextCell: { hNext vNext ^theCell -- b } word0 hNext tbool vNext tbool ^theCell get: ListHandle call lNextCell ;m :m Rect: ( ^cellRect theCell -- ) get: listHandle call lRect ;m :m Search: { addr len ^searchProc ^theCell -- b } word0 addr len makeint ^searchProc ^theCell get: ListHandle call lSearch ;m :m Size: { width height -- } width makeint height makeint get: ListHandle call lSize ;m \ List Display :m DrawCell: ( theCell -- ) \ Draw a particular cell. get: ListHandle call lDraw ;m :m DoDraw: ( drawIt -- ) \ turns on drawing. tbool get: ListHandle call lDoDraw ;m :m Scroll: ( dcols dRows -- ) \ In case you want to scroll this puppy \ by yourself. get: ListHandle call lScroll ;m :m AutoScroll: ( -- ) \ Will scroll the first highlighted item. get: ListHandle call lAutoScroll ;m :m Update: ( theRgn -- ) \ Redraws the list. get: ListRegion get: ListHandle call lUpdate ;m :m Activate: ( -- ) true tbool get: ListHandle call lActivate ;m :m Deactivate: ( -- ) false tbool get: ListHandle call lActivate ;m ;CLASS \ Class ListView \ \ This class provides list manager support for views under Mops. \ Greg Haverkamp \ need ListRecord \ need ListBlock :CLASS ListView super{ view } record { bool Lists? bool List? MyPtrList Lists MyPtrList SubListViews } \ * The following are adaptations that allow easier use \ * of lists... including checking for clicks in the content \ * and the like. :m List: put: List? ;m :m List?: get: List? ;m :m Lists: put: Lists? ;m \ ListCheck: is called by the ListWindow's content: method to see if \ the click occurred inside of a list. :m ListCheck: \ ( -- b ) Returns true if we've handled the click. get: Lists? \ Do we have listViews in this view? NIF false EXIT THEN BEGIN each: subListviews WHILE ListCheck: ** IF uneach: subListviews true EXIT THEN REPEAT 0 where: fEvent g->l addr: viewRect call PtInRect IF exec: clickHndlr list?: self \ Is there really a list in this view? ELSE false THEN ;m :m addListView: { ptr -- } \ Call this to add a view that possesses a list ptr add: SubListViews ptr addView: super false Lists: self false List: self ;m :m AddList: ( ^list -- ) \ Call this to add a list to a listview... \ but only after calling Newlist: add: Lists true Lists: self true List: self ;m :m RemoveList: ( ^list -- ) \ Call this to get rid of a list remove: lists drop length?: lists 0 = if false Lists: self false List: self then ;m ;CLASS